unit Resource;

interface
uses ResourceManagerI, classes;
Type
TXMLSaveable=class
private
function GetXMLRepresentation:string; virtual; abstract;
public
property XMLRepresentation:string read GetXMLRepresentation;
end;
TResource=Class(TXMLSaveable)
private
FName:String;
FFileName:string;
FType:TResourceType;
FRawData:pointer;
FRawDataSize:cardinal;
FData:pointer;
FParams:TStringList;
FTempFileName:string;
function GetXMLRepresentation:string; override;
public
constructor create;
destructor destroy; override;
Function SaveToTempFile:string;
procedure Init;
procedure allocMem;
procedure SaveToFile;
Property Name:string read FName write FName;
property ResType:TResourceType read FType write FType;
property FileName:string read FFileName write FFileName;
property RawData:pointer read FRawData write FRawData;
property RawDataSize:cardinal read FRawDataSize write FRawDataSize;
property Data:Pointer read FData;
property Params:TStringList read FParams;
end;
TMultilingualString=class(TXMLSaveable)
private
FStrings:TList;
function GetXMLRepresentation:string; override;
public
procedure AddString(const lang:string; const text:WideString);
Function GetString(lang:string):wideString;
constructor create;
destructor destroy; override;
end;
TNamespace= class(TXMLSaveable)
private
FName:string;
FList:TStringList;
FParent:TObject;
function GetXMLRepresentation:string; override;
                 public
                 constructor create(const name:string; parent:TObject);
                 destructor destroy; override;
                  property list:TStringList read FList;
                  property name:string read FName;
property parent:TObject read FParent;
                                    end;
Procedure AddResourceHandler(const ResType:TResourceType; const Init:TResourceInitializerFunc; const Free:TResourceFreeFunc); cdecl;
implementation
uses sysutils;
               Type PMStringNode=^TMStringNode;
               TMStringNode=record
               lang:string[7];
               text:WideString;
               end;
type PHandlerNode = ^THandlerNode;
THandlerNode=record
ResType:TResourceType;
     init:TResourceInitializerFunc;
     Free:TResourceFreeFunc;
end;
var Handlers:TList;

Procedure AddResourceHandler(const ResType:TResourceType; const Init:TResourceInitializerFunc;
const Free:TResourceFreeFunc); cdecl;
var n:PHandlerNode;
begin
                   new(n);
n^.ResType := ResType;
                   n^.init := Init;
                   n^.Free := free;
                   if Handlers = nil then handlers := TList.Create;
                   handlers.Add(n);
                   end;

                   Function GetResourceHandler(const ResType:TResourceType):PHandlerNode;
var i:integer;
begin
result := nil;
if handlers = nil then Handlers := TList.Create;
for i := 0 to handlers.Count -1 do begin
if PHandlerNode(Handlers[i])^.ResType = ResType then begin
result := handlers[i];
break;
end;
         end;
                   end;
                   { TResource }

procedure TResource.allocMem;
begin
if FRawDataSize > 0 then getMem(FRawData, FRawDataSize);
end;

constructor TResource.create;
  begin
FParams := TStringList.Create;
end;

destructor TResource.destroy;
var n:PHandlerNode;
i:integer;
begin
for i:=0 to FParams.Count -1 do
FParams.Objects[i].Free;
FParams.Free;
    if FRawData <> nil then FreeMem(FRawData);
                   n := GetResourceHandler(FType);
if (n <> nil) and (@n^.Free <> nil)  then
                   n^.Free(FData);
if FTempFileName <> '' then deleteFile(FTempFileName);
  inherited;
end;

function TResource.GetXMLRepresentation: string;
var i:integer;
begin
result := format('<resource name= "%s" type = "%d" filename = "%s">'#13#10, [name, ResType, filename]);
for I := 0 to FParams.Count -1 do begin
if FParams.Objects[i] is TMultilingualString then
result := result + format('<param name = "%s">'#13#10'%s'#13#10, [FParams[i],
(FParams.Objects[i] as TMultilingualString).XMLRepresentation])
else
result := result + format('<param name = "%s">%s', [FParams.Names[i], FParams.Values[FParams.Names[i]]]);
result := result + '</param>'#13#10;
end;
result := result + '</resource>'#13#10;
end;

procedure TResource.Init;
var n:PHandlerNode;
FreeRawData:boolean;
begin
n := GetResourceHandler(FType);
if n <> nil then begin
FreeRawData:=false;
FData := n^.init(FRawData, FRawDataSize, FreeRawData, PChar(Name));
if FreeRawData then begin
freemem(FRawData);
FRawData := nil;
end;
end;
end;

procedure TResource.SaveToFile;
var s:string;
f:file;
begin
if (FRawData = nil) or (FRawDataSize = 0) or (FileName = '') then exit;
s := ExtractFileDir(FFileName);
if s <> '' then begin
createDir(s);
SetCurrentDir(s);
end;
       assign(f, ExtractFileName(FFileName));
rewrite(f, 1);
blockwrite(f, FRawData^, FRawDataSize);
close(f);
             end;

function TResource.SaveToTempFile: string;
var f:File;
begin
if FTempFileName <> '' then begin
result := FTempFileName;
exit;
end;
FTempFileName := FName + IntToStr(random(MaxInt)) + '.tmp';
assign(f, FTempFileName);
rewrite(f,1);
BlockWrite(f, FRawData^, FRawDataSize);
Close(f);
end;

{ TMultilingualString }

procedure TMultilingualString.AddString(const lang: string;
  const text: WideString);
  var n:PMStringNode;
  begin
  new(n);
  if lang = '' then n^.lang := 'default'
  else if length(lang) > 7 then
  n^.lang := copy(lang, 1, 7) else n^.lang := lang;
n^.text := text;
FStrings.Add(n);
  end;

constructor TMultilingualString.create;
begin
FStrings := TList.Create;
end;

destructor TMultilingualString.destroy;
var i:integer;
begin
for i := 0 to FStrings.Count -1 do
dispose(FStrings[i]);
  FStrings.Free;
  inherited;
end;

function TMultilingualString.GetString(lang: string): wideString;
var i:integer;
n,default:PMStringNode;
begin
result := '';
if lang = '' then lang := 'default';
default := nil;
               for i := 0 to FStrings.Count -1 do begin
n := FStrings[i];
if n^.lang = lang then begin
result := n^.text;
exit;
end;
    if n^.lang = 'default' then default := n;
end;
if (result = '') and (default <> nil) then result := default^.lang else
result := 'not translated';
               end;

function TMultilingualString.GetXMLRepresentation: string;
var i:integer;
n:PMStringNode;
begin
result := '<str>'#13#10;
              for i:=0 to FStrings.Count -1 do begin
              n := FStrings[i];
result := result +format('<%s>%s</%s>'#13#10, [n^.lang, n^.text, n^.lang]);
              end;
              result := result + '</str>';
              end;

{ TNamespace }

constructor TNamespace.create(const name: string; parent:TObject);
begin
Fname := name;
FList := TStringList.Create;
FParent := parent;
end;

destructor TNamespace.destroy;
var i:integer;
begin
              for i := 0 to list.Count - 1 do
              list.Objects[i].Free;
              list.Free;
  inherited;
end;

function TNamespace.GetXMLRepresentation: string;
var i:integer;
begin
result := format('<namespace name = "%s">'#13#10, [name]);
               for i := 0 to FList.Count -1 do
               result := result + (FList.Objects[i] as TXMLSaveable).XMLRepresentation;
               result := result + '</namespace>'#13#10;
               end;

end.
